perm filename RHYC.F4[MUS,LCS] blob
sn#084623 filedate 1974-01-29 generic text, type T, neo UTF8
C FILE NAME='RHYC'
C THIS IS FOR RHYTHMIC INPUT FROM BUTTONS.
C ORDER FOR EDITING WITH 'CONDUCT'.
C 1. GET LISTING. 2. ADD,DELETE,CHANGE DURATIONS,TEMPO,METER.
C 3. QUICK TEMPO CHANGES MUST COME LAST!
DIMENSION IV(200),V(200),W(600)
COMMON V,N
1700 BB=.1
1032 TYPE 1000
32 X=0
I=1
J=1
1000 FORMAT(' INFO? OR WHAT?'/)
ACCEPT 50,N
50 FORMAT(A1)
IF(N.EQ.'I')TYPE 2000
IF(N.EQ.'I')GO TO 1032
2000 FORMAT(' COMMANDS: R(EAD), S(AVE), L(IST), C(ONDUCT),
1 E(DIT), TAP=<CR>'/' ALL RESTS, AS WELL AS NOTES, MUST BE
1 TAPPED.'/' IF THERE ARE NO TAPS FOR 10" THE LAST TAP IS TAKEN AS
1 THE TERMINATION OF THE INPUT.'/)
IF((N.EQ.'R').OR.(N.EQ.'S'))GO TO 6
IF(N.EQ.'E')GO TO 1013
IF(N.EQ.'L')GO TO 24
3001 TYPE 1001
1001 FORMAT(' TAP ONCE, THEN PLAY RHYTHM'/)
CALL RHYTHM(V,II)
DO 2001 K=II+1,200
2001 V(K)=0
A=0
L=1
IF(N.EQ.'C')L=2
DO 1021 K=L,II
1021 A=A+V(K)
2021 FORMAT(I4,' NOTES ',F8.3,'"'/)
L=II
IF(N.EQ.'C')L=L-1
TYPE 2021,L,A
21 FORMAT(2F)
TYPE 12
12 FORMAT(' OK=0,TRY AGAIN=1'/)
ACCEPT 5,K
ICON=0
IF(K.EQ.1)GO TO 3001
IF(N.NE.'C')GO TO 1032
C WHEN 'CONDUCTING', UPBEAT MUST BE TAPPED.
C METER OF UPBEAT (NOTE #0) MAY BE RESET.
ALLM=1.
ICON=-1
3012 Q=ALLM
DO 2012 K=3,II*3,3
2012 W(K)=Q
IF(ALLM.EQ.X)GO TO 300
GO TO 1032
24 IF(ICON)GO TO 100
9024 N=0
7024 FORMAT(/' DURATIONS OF NOTES',18XA5,12X,'TOTAL=',F7.3,' SECS.'/)
8024 FORMAT(' NOTE 0 IS UPBEAT (NOT INCLUDED IN DURATION)')
L=0
IF(ICON)L=1
K=1-L
PRINT 7024,QSLAC,A
IF(ICON)PRINT 8024
DO 14 LL=1,40
KA=K+1
KB=KA+1
KC=KB+1
KD=KC+1
PRINT 15,K,V(K+L),KA,V(KA+L),KB,V(KB+L),KC,V(KC+L),KD,V(KD+L)
DO 16 M=1,5
IF((V(K+M+L).EQ.0).OR.(V(K+M+L).EQ.999.0))GO TO 15
16 CONTINUE
14 K=K+5
15 FORMAT(5(' (',I3,')',F7.3)/)
CALL EXIT
1013 TYPE 17
17 FORMAT(' TYPE C(HANGE), A(DD NOTE), D(ELETE), T(EMPO CHANGE),
1'/' M(ETER CHANGE), Q(UICK CHANGE), J(OIN), S(PLIT) OR <CR>'/)
ACCEPT 50,K
IF(K.EQ.'-1')GO TO 1013
C WITH 'CONDUCT', ADDED BEATS ARE IN TERMS OF REAL TIME.
IF(K.EQ.'M')GO TO 101
IF((K.NE.'C').AND.(K.NE.'Q'))GO TO 18
TYPE 19
19 FORMAT(' TYPE NOTE N'/)
ACCEPT 5,KA
IF(KA)GO TO 1013
IF(K.EQ.'Q')GO TO 120
L=KA
IF(ICON)KA=KA+1
TYPE 20,L,V(KA)
20 FORMAT(' NOTE',I3,' WAS',F9.4,', CHANGE TO ',$)
X=V(KA)
ACCEPT 21,V(KA)
IF(V(KA).LE.0)V(KA)=X
A=A+V(KA)-X
IF(ICON+1)GO TO 300
GO TO 1013
220 FORMAT(' BEAT',I3,', TF1=',F5.3,', TF2=',F5.3,/
1 ' CHANGE TF1 TO ',$)
120 L=KA*3+1
TYPE 220,KA,W(L),W(L+1)
ACCEPT 21,Y
IF(Y.LE.0)GO TO 1013
X=W(L+1)+W(L)-Y
W(L)=Y
W(L+1)=X
KA=KA+2
LA=L+2
GO TO 1300
C QUICK CHANGES MUST BE DONE LAST. THEY ARE WIPED OUT WHEN ANY OTHER EDITING IS DONE!
C THEY MUST BE IN ORDER FROM 1 TO END.
18 IF(K.NE.'A')GO TO 22
TYPE 23
23 FORMAT(' ADD AFTER WHICH NOTE?'/)
ACCEPT 5,K
IF(K)GO TO 1013
IF(ICON)K=K+1
TYPE 25
25 FORMAT(' TYPE NOTE VALUE'/)
ACCEPT 21,X
IF(X.LE.0)GO TO 18
A=A+X
125 II=II+1
IF(ICON)W((II-1)*3)=1.
L=II+10
DO 26 M=L,1,-1
V(M)=V(M-1)
IF(M-1.NE.K)GO TO 26
V(M)=X
C 'METERS' MUST BE CHECKED AFTER 'ADD' OR 'DELETE' IS USED.
IF(ICON)GO TO 2300
GO TO 1013
26 CONTINUE
GO TO 1032
22 IF(K.NE.'D')GO TO 229
TYPE 28
28 FORMAT(' DELETE WHICH NOTE?'/)
ACCEPT 5,K
IF(K)GO TO 1013
IF(ICON)K=K+1
A=A-V(K)
429 II=II-1
C KII WAS 1 IN NEXT LINE.
DO 29 KA=K,II
29 V(KA)=V(KA+1)
V(II+1)=0
IF(ICON)GO TO 2300
GO TO 1013
229 IF(K.NE.'J')GO TO 329
C JOINS NOTE TO FOLLOWING NOTE.
TYPE 19
ACCEPT 5,K
IF(ICON)K=K+1
V(K)=V(K)+V(K+1)
K=K+1
GO TO 429
329 FORMAT(' TYPE % FOR 1ST NOTE.'/)
IF(K.NE.'S')GO TO 35
C SPLITS NOTE BY %S.
TYPE 19
ACCEPT 5,K
L=K
IF(ICON)K=K+1
TYPE 329
ACCEPT 21,X
Y=V(K)*X
X=V(K)-Y
V(K)=Y
LA=L+1
TYPE 529,L,V(K),LA,X
529 FORMAT(2(' NOTE',I3,' =',F6.3/))
GO TO 125
410 KB=II
KC=II
KA=1
1410 G=3.9
ICNT=1
LL='9'
IF(KB.GT.51)KB=51
KC=KC-KB
KD=KB*2
310 KK=9
L=-1
C WATCH ARRAY LENGTHS HERE.
J=KB
IF(KA.GT.1)J=J+3
DO 210 K=KA*3+1,(J+KA-1)*3-1,3
X=W(K)
Y=W(K+1)
L=L+2
IV(L)='. '
IV(L+1)=' '
IF(L.NE.KK)GO TO 1210
2210 IV(L)=-2147483648
KK=KK+10
1210 IF((Y.LT.G+.05).AND.(Y.GT.G-.05))IV(L+1)=LL
210 IF((X.LT.G+.05).AND.(X.GT.G-.05))IV(L)=LL
X=' '
IF(ICNT.EQ.10)X=' 180'
IF(ICNT.EQ.15)X=' 150'
IF(ICNT.EQ.20)X=' 120'
IF(ICNT.EQ.30)X=' 60'
IF(ICNT.EQ.25)X=' 90'
IF(ICNT.EQ.5)X=' 210'
IF(ICNT.EQ.33)X=' 42'
PRINT 110,X,G,(IV(K),K=1,KD)
ICNT=ICNT+1
110 FORMAT(A4,F5.1,2X102A1)
IF(G.LT..4)GO TO 510
G=G-.1
LL=LL-536870912
C ABOVE MOVES '9' TO '0' ETC.
IF(LL.LT.'0')LL='9'
GO TO 310
510 IF(KA-2)LB='A'
IF(LB.GE.'A')LB=LB-536870912
LL=1
Y=0
M=(KB+KA-1)*3
IF(M-KA*3.GE.150)M=M-1
DO 610 K=KA*3,M,3
IV(LL)=' '
X=W(K)
IF(X.EQ.1.)GO TO 610
IF(X.EQ.Y)GO TO 1610
LB=LB+536870912
Y=X
1610 IV(LL)=LB
610 LL=LL+1
IV(LL)=' '
C WHAT IF LAST BEAT IS NOT 4 16THS?
KD=KB-KA*(1/KA)
PRINT 710,(IV(K),K=1,KD)
710 FORMAT(29X,'10',18X,'20',18X,'30',18X,'40'/11X50A2)
C 200 BEAT LIMIT SO FAR.
LL='A'
X=1.
LA=0
DO 910 K=KA*3,M-1,3
Y=W(K)
L=Y/.25
IF((Y.EQ.X).OR.(Y.EQ.1.).OR.(L.EQ.LA))GO TO 910
LA=L
PRINT 1110,LL,L
LL=LL+536879012
910 X=Y
IF(KC.LE.0)GO TO 9024
KA=KB+KA-1
C CHECK THIS OUT!!
KB=KC
PRINT 2410
GO TO 1410
2410 FORMAT('1')
1110 FORMAT(1XA1,'=',I2,' 16TH NOTES')
35 FORMAT(' TEMPO FACTOR IS 1, CHANGE TO'/)
IF(K.NE.'T')GO TO 1032
TYPE 35
ACCEPT 21,X
IF(X)GO TO 1013
A=0
IF(ICON)A=-V(1)/X
DO 36 K=1,II
V(K)=V(K)/X
36 A=A+V(K)
IF(ICON)GO TO 2300
GO TO 1032
100 IF(ICON+1)GO TO 410
2300 W(1)=980000.
300 W(2)=II*3-2
KA=2
LA=3
X=Q/V(1)
1300 L=LA
DO 1200 K=KA,II
Y=W(L)/V(K)
W(L+1)=Y
W(L+2)=Y
1200 L=L+3
L=LA
3300 DO 500 K=KA,II
Y=W(L)/V(K)
Z=Y
IF(K.LT.II)Z=W(L+4)
B=ABS(Y-X)
C=ABS(Z-Y)
D=B-C/2
IF(Y-X)GO TO 700
IF(Z-Y)GO TO 900
IF(D)GO TO 600
IF(C.GE..05)B=-D
IF(C.LT..05)B=-B*BB
C '.2' IS ARBITRARY. TO SMOOTH JUMPS IN TEMPO.
GO TO 200
700 IF(Z-Y.LE.0)GO TO 800
B=B*.5
GO TO 200
800 IF(D)GO TO 200
IF(C.GE..05)B=D
IF(C.LT..05)B=B*BB
GO TO 200
900 B=-B*.5
GO TO 200
600 B=-B
200 W(L+1)=W(L+1)+B
W(L+2)=W(L+2)-B
X=W(L+2)
500 L=L+3
L=L-1
DO 2100 K=1,7
2100 W(L+K)=999.
ICON=-2
IF(N.EQ.'L')GO TO 410
IF(N.EQ.'E')GO TO 1013
GO TO 2
101 FORMAT(' CHANGE WHICH BEAT?'/)
TYPE 101
ACCEPT 5,KA
C I.E. 3/8 = 4,8 5/16 = 4,16.
TYPE 201
201 FORMAT(' TYPE VALUE OF BEAT'/)
X=0
ACCEPT 5,(IV(K),K=1,8)
DO 301 K=1,8
Y=IV(K)
IF(Y.LT.99.)GO TO 301
ALLM=X
GO TO 3012
C SETS METER FOR ALL BEATS IF LAST NUMBER IS .GE.99.
301 IF(Y.NE.0)X=X+4./Y
W(KA*3)=X
GO TO 300
C FIX SO CHANGES GO FROM THIS POINT ON.
C QUICK CHANGES OF TEMPO MUST BE SET (OR RESET) AFTER! ANY OTHER EDITING.
6 TYPE 2
IF(N.EQ.'R')ICON=0
IF(ICON.EQ.-1)GO TO 100
2 FORMAT(' TYPE NAME'/)
ACCEPT 4,QSLAC
IF(QSLAC.EQ.'-1')GO TO 1032
IF(QSLAC.NE.' ')GO TO 4
QSLAC='BIN'
4 FORMAT(A5)
5 FORMAT(8I)
CALL ZERPP
IF(ICON)GO TO 1005
IF(N.EQ.'R') GO TO 27
DO 102 K=1,II+10
102 W(K)=V(K)
1005 CALL OFILE(1,QSLAC)
10 DO 7 K=1,7
IF(W(I).EQ.0)W(I)=999.0
7 I=I+1
8 WRITE(1,11)(W(K),K=J,J+6)
IF((W(I-1).EQ.999.0).OR.(W(I-1).EQ.0))GO TO 9
J=I
GO TO 10
C 'V' KEEPS BASIC DATA AT ALL TIMES, 'W' WILL HAVE MODIFIED DATA.(98000,WDCNT,TDUR,T1,T2,ETC.)
9 WRITE(1)II,A,V,Q
END FILE 1
CALL EXIT
27 CALL IFILE(1,QSLAC)
30 READ(1,11)(W(K),K=J,J+6)
IF(W(J+6).EQ.999.0)GO TO 6013
J=J+7
GO TO 30
6013 READ(1)II,A,V,Q
IF(W(1).GT.999.)ICON=-2
GO TO 1032
11 FORMAT(1X7F)
111 FORMAT(I,202F)
END